home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / numerical / slatec / dcsevl.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  1.6 KB  |  43 lines
  1. ;;; Compiled by f2cl version 2.0 beta 2002-05-06
  2. ;;; 
  3. ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  4. ;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
  5. ;;;           (:array-slicing nil) (:declare-common nil)
  6. ;;;           (:float-format double-float))
  7.  
  8. (in-package "SLATEC")
  9.  
  10.  
  11. (let ((onepl 0.0) (first nil))
  12.   (declare (type f2cl-lib:logical first) (type double-float onepl))
  13.   (setq first f2cl-lib:%true%)
  14.   (defun dcsevl (x cs n)
  15.     (declare (type f2cl-lib:integer4 n)
  16.              (type (simple-array double-float (*)) cs)
  17.              (type double-float x))
  18.     (prog ((b0 0.0) (b1 0.0) (b2 0.0) (twox 0.0) (dcsevl 0.0) (ni 0) (i 0))
  19.       (declare (type f2cl-lib:integer4 i ni)
  20.                (type double-float dcsevl twox b2 b1 b0))
  21.       (if first (setf onepl (+ 1.0 (f2cl-lib:d1mach 4))))
  22.       (setf first f2cl-lib:%false%)
  23.       (if (< n 1) (xermsg "SLATEC" "DCSEVL" "NUMBER OF TERMS  <=  0" 2 2))
  24.       (if (> n 1000) (xermsg "SLATEC" "DCSEVL" "NUMBER OF TERMS  >  1000" 3 2))
  25.       (if (> (abs x) onepl)
  26.           (xermsg "SLATEC" "DCSEVL" "X OUTSIDE THE INTERVAL (-1,+1)" 1 1))
  27.       (setf b1 0.0)
  28.       (setf b0 0.0)
  29.       (setf twox (* 2.0 x))
  30.       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  31.                     ((> i n) nil)
  32.         (tagbody
  33.           (setf b2 b1)
  34.           (setf b1 b0)
  35.           (setf ni (f2cl-lib:int-sub (f2cl-lib:int-add n 1) i))
  36.           (setf b0 (+ (- (* twox b1) b2) (f2cl-lib:fref cs (ni) ((1 *)))))
  37.          label10))
  38.       (setf dcsevl (* 0.5 (- b0 b2)))
  39.       (go end_label)
  40.      end_label
  41.       (return (values dcsevl nil nil nil)))))
  42.  
  43.